Author: Adam Melton Date Submitted: 5/23/2005 Category: Security Code and Programs Compatibility: VB 6 This code has been accessed 1105 times.
Email Yourself this snippet:
nada
Code
Public Function Cryptt(ByVal StrString As String, Decrypt As Boolean) Dim intloop As Integer Dim intloop2 As Integer Dim Rand As Integer Dim intRand As Integer Dim start As Integer Dim CS As String Dim CS2 Dim CS3 On Error Resume Next CS = "" CS2 = StrString CS3 = "" Randomize If Decrypt = True Then If Len(CS) Mod 2 = 0 Then For intloop2 = 1 To 3 CS = "" For intloop = 1 To Len(CS2) Step 6 CS = CS & Chr(Mid(CS2, intloop, 2)) Next intloop CS2 = CS Next intloop2 CS = CS2 CS2 = "" For intloop = 1 To Len(CS) / 2 Step 1 CS2 = CS2 & Mid(CS, intloop, 1) Next intloop For intloop = Len(CS) / 2 + 1 To Len(CS) Step 1 CS3 = CS3 & Mid(CS, intloop, 1) Next intloop CS = "" For intloop = 1 To Len(CS3) + Len(CS2) Step 1 CS = CS & Mid(CS3, intloop, 1) & Mid(CS2, intloop, 1) Next intloop CS2 = "" For intloop = Len(CS) To 1 Step -1 CS2 = CS2 & Mid(CS, intloop, 1) Next intloop CS = "" For intloop = 1 To Len(CS2) / 2 Step 1 CS = CS & Mid(CS2, intloop, 1) Next intloop CS3 = "" For intloop = Len(CS) To 1 Step -1 CS3 = CS3 & Mid(CS, intloop, 1) Next intloop CS = "" For intloop = Len(CS2) / 2 + 1 To Len(CS2) Step 1 CS = CS & Mid(CS2, intloop, 1) Next intloop CS2 = CS CS = "" For intloop = 1 To Len(CS2) Step 1 CS = CS & Mid(CS2, intloop, 1) & Mid(CS3, intloop, 1) Next intloop CS2 = CS CS = "" CS3 = "" Else For intloop2 = 1 To 3 CS = "" For intloop = 1 To Len(CS2) Step 6 CS = CS & Chr(Mid(CS2, intloop, 2)) Next intloop CS2 = CS Next intloop2 MsgBox CS CS = CS2 CS2 = "" For intloop = 1 To Len(CS) / 2 Step 1 CS2 = CS2 & Mid(CS, intloop, 1) Next intloop For intloop = Len(CS) / 2 + 1 To Len(CS) Step 1 CS3 = CS3 & Mid(CS, intloop, 1) Next intloop CS = "" For intloop = 1 To Len(CS3) + Len(CS2) Step 1 CS = CS & Mid(CS3, intloop, 1) & Mid(CS2, intloop, 1) Next intloop CS2 = "" For intloop = Len(CS) To 1 Step -1 CS2 = CS2 & Mid(CS, intloop, 1) Next intloop CS = "" For intloop = 1 To Len(CS2) / 2 Step 1 CS = CS & Mid(CS2, intloop, 1) Next intloop CS3 = "" For intloop = Len(CS) To 1 Step -1 CS3 = CS3 & Mid(CS, intloop, 1) Next intloop CS = "" For intloop = Len(CS2) / 2 + 1 To Len(CS2) Step 1 CS = CS & Mid(CS2, intloop, 1) Next intloop CS2 = CS CS = "" For intloop = 1 To Len(CS2) Step 1 CS = CS & Mid(CS2, intloop, 1) & Mid(CS3, intloop, 1) Next intloop CS2 = CS CS = "" CS3 = "" End If ElseIf Decrypt = False Then CS = "" If Len(CS2) Mod 2 = 0 Then For intloop = 2 To Len(CS2) Step 2 CS = CS & Mid(CS2, intloop, 1) Next intloop For intloop = Len(CS) To 1 Step -1 CS3 = CS3 & Mid(CS, intloop, 1) Next intloop CS = CS3 CS3 = "" For intloop = 1 To Len(CS2) - 1 Step 2 Next intloop CS2 = CS CS = "" For intloop = Len(CS2) To 1 Step -1 Next intloop CS2 = "" For intloop = 2 To Len(CS) Step 2 CS2 = CS2 & Mid(CS, intloop, 1) Next intloop For intloop = 1 To Len(CS) - 1 Step 2 CS2 = CS2 & Mid(CS, intloop, 1) Next intloop For intloop2 = 1 To 3 CS = "" For intloop = 1 To Len(CS2) Step 1 Rand = Rand - Rand For intRand = 1 To 4 Step 1 Rand = Rand & Int((9 - 1 + 1) * Rnd + 1) Next intRand CS = CS & Asc(Mid(UCase(CS2), intloop, 1)) & Rand Next intloop CS2 = CS Next intloop2 CS = "" Else CS2 = CS2 & Mid(CS2, Len(CS2), 1) MsgBox CS2 For intloop = 2 To Len(CS2) Step 2 CS = CS & Mid(CS2, intloop, 1) Next intloop For intloop = Len(CS) To 1 Step -1 CS3 = CS3 & Mid(CS, intloop, 1) Next intloop CS = CS3 CS3 = "" For intloop = 1 To Len(CS2) - 1 Step 2 CS = CS & Mid(CS2, intloop, 1) Next intloop CS2 = CS CS = "" For intloop = Len(CS2) To 1 Step -1 CS = CS & Mid(CS2, intloop, 1) Next intloop CS2 = "" For intloop = 2 To Len(CS) Step 2 CS2 = CS2 & Mid(CS, intloop, 1) Next intloop For intloop = 1 To Len(CS) - 1 Step 2 CS2 = CS2 & Mid(CS, intloop, 1) Next intloop CS = "" For intloop2 = 1 To 3 CS = "" For intloop = 1 To Len(CS2) Step 1 Rand = Rand - Rand For intRand = 1 To 4 Step 1 Rand = Rand & Int((9 - 1 + 1) * Rnd + 1) Next intRand CS = CS & Asc(Mid(UCase(CS2), intloop, 1)) & Rand Next intloop CS2 = CS Next intloop2 End If End If Cryptt = CS2 End Function
DEVELOPMENT SearchVB.com
ENTERPRISE IT MANAGEMENT SearchCIO.com